;;;
;;; mp3tunes.scm - mp3tunes filesystem
;;;
;;;   Copyright (c) 2008 Teruaki Gemma <teruakigemma@gmail.com>
;;;
;;;   Redistribution and use in source and binary forms, with or without
;;;   modification, are permitted provided that the following conditions
;;;   are met:
;;;
;;;   1. Redistributions of source code must retain the above copyright
;;;      notice, this list of conditions and the following disclaimer.
;;;
;;;   2. Redistributions in binary form must reproduce the above copyright
;;;      notice, this list of conditions and the following disclaimer in the
;;;      documentation and/or other materials provided with the distribution.
;;;
;;;   3. Neither the name of the authors nor the names of its contributors
;;;      may be used to endorse or promote products derived from this
;;;      software without specific prior written permission.
;;;
;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;;  $Id$
;;;

(use srfi-1)
(use rfc.http)
(use rfc.uri)
(use sxml.ssax)
(use sxml.sxpath)
(use sxml.tools)
(use sxml.serializer)

(define username "")
(define password "")
(define partner_token "")
(define login-sxml '())
(define login-sxml-session-id "")

(define (alist->query-string alist)
  (string-join (map (lambda (x) 
		      (string-append (x->string (car x)) "=" (uri-encode-string (x->string (cdr x)))))
		    alist)
	       "&"))

(define (with-http-get server request-uri . option)
  (let-keywords
   option ((query-string #f))
   (receive (status header body)
       (http-get server (if query-string
			  (string-append request-uri "?" query-string)
			  request-uri))
     ;;(format #t "~a: ~a\n" status body)
     (and (string=? status "200") (call-with-input-string body (cut ssax:xml->sxml <> '()))))))
  
(define (write-partner_token sxml)
  (and (every (lambda (x)
		(let1 m (#/partner_token=/ (cadr x))
		  (and (regmatch? m)
		       (sxml:change-content! x (list (string-append (m 'before)
								    (string-append "partner_token=" partner_token)
								    (m 'after)))))))
	      (append-map (lambda (x)
			    ((sxpath x) sxml))
			  '("//downloadURL" "//playURL" "//playmixURL")))
       sxml))

(define (mp3tunes-login)
  (with-http-get "shop.mp3tunes.com"
		 "/api/v1/login"
		 (alist->query-string `((output        . xml)
					(username      . ,username)
					(password      . ,password)
					(partner_token . ,partner_token)))))
      
(define (mp3tunes-account-data)
  (with-http-get "ws.mp3tunes.com"
		 "/api/v1/accountData"
		 (alist->query-string `((output . xml)
					(sid    . ,login-sxml-session-id)))))

(define (mp3tunes-last-update type)
  (with-http-get "ws.mp3tunes.com"
		 "/api/v1/lastUpdate"
		 (alist->query-string `((output . xml)
					(sid    . ,login-sxml-session-id)
					(type   . ,type)))))

(define (mp3tunes-locker-data type . option)
  (let-keywords
   option ((count #f)
	   (set   #f)
	   (album_id #f)
	   (artist_id #f)
	   (playlist_id #f)
	   (noplaymix #f)
	   (token #f))
   (define al `((output . xml)
		(sid    . ,login-sxml-session-id)
		(type   . ,type)))
   (case type
     ('artist
      (when token       (push! al `(token . ,token))))
     ('album
      (when artist_id   (push! al `(artist_id . ,artist_id)))
      (when token       (push! al `(token . ,token))))
     ('track
      (when artist_id   (push! al `(artist_id . ,artist_id)))
      (when album_id    (push! al `(album_id . ,album_id)))
      (when playlist_id (push! al `(playlist_id . ,playlist_id)))
      (when token       (push! al `(token . ,token))))
     ('playlist)
     ('playmix)
     ('artist_token)
     ('album_token)
     ('track_token))
   (with-http-get "ws.mp3tunes.com"
		  "/api/v1/lockerData"
		  (alist->query-string al))))

(define (mp3tunes-locker-search type s . option)
  (let-keywords 
   option ((count #f)
	   (set   #f)
	   (result_data_level #f))
   (define al `((output . xml)
		(sid    . ,login-sxml-session-id)
		(type   . ,(if (list? type)
			   (string-join (map symbol->string type) ",")
			   (symbol->string type)))
		(s      . ,s)))
   (when count             (push! al `(count . ,count)))
   (when set               (push! al `(set . ,set)))
   (when result_data_level (push! al `(result_data_level . ,result_data_level)))
   (with-http-get "ws.mp3tunes.com"
		  "/api/v1/lockerSearch" 
		  (alist->query-string al))))

;; (define (mp3tunes-playlist-add title . option)
;;   (let-keywords 
;;    option ((keys #f))
;;    (define al `((output . xml)
;; 		(sid    . ,login-sxml-session-id)
;; 		(title  . ,title)))
;;    (when keys (push! al `(keys . ,(if (list? keys)
;; 				    (string-join keys ",")
;; 				    keys))))
;;    (with-http-get "ws.mp3tunes.com"
;; 		  "/api/v1/playlistAdd"
;; 		  (alist->query-string al))))

;; (define (mp3tunes-playlist-delete playlist_id)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output 'xml)
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'playlist_id playlist_id)
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "ws.mp3tunes.com"
;; 		(format "/api/v1/playlistDelete?~a" (request-params)))
;;      (format #t "~a: ~a\n" status body)
;;      (and (string=? status "200") body)))

;; (define (mp3tunes-playlist-edit playlist_id title)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'playlist_id playlist_id)
;;     (hash-table-put! ht 'title title)
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "ws.mp3tunes.com"
;; 		(format "/api/v1/playlistEdit?~a" (request-params)))
;;      (format #t "~a: ~a\n" status body)
;;      (and (string=? status "200") body)))
  
;; (define (mp3tunes-playlist-track-add playlist_id file_key . option)
;;   (define (request-params position)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'playlist_id playlist_id)
;;     (hash-table-put! ht 'file_key file_key)
;;     (and position (hash-table-put! ht 'position position))
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (let-keywords
;;    option ((position #f))
;;    (receive (status header body)
;;        (http-get "ws.mp3tunes.com"
;; 		 (format "/api/v1/playlistTrackAdd?~a" (request-params position)))
;;      (format #t "~a: ~a\n" status body)
;;      (and (string=? status "200") body))))

;; (define (mp3tunes-playlist-track-delete playlist_id file_key)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'playlist_id playlist_id)
;;     (hash-table-put! ht 'file_key file_key)
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "ws.mp3tunes.com"
;; 		(format "/api/v1/playlistTrackDelete?~a" (request-params)))
;;     (format #t "~a: ~a\n" status body)
;;     (and (string=? status "200") body)))

;; (define (mp3tunes-playlist-track-reorder playlist_id file_key position)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'playlist_id playlist_id)
;;     (hash-table-put! ht 'file_key file_key)
;;     (hash-table-put! ht 'position position)
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "ws.mp3tunes.com"
;; 		(format "/api/v1/playlistTrackReorder?~a" (request-params)))
;;     (format #t "~a: ~a\n" status body)
;;     (and (string=? status "200") body)))

;; (define (mp3tunes-move-into-trash file_key)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "content.mp3tunes.com"
;; 		(format "/storage/lockerDelete/~a?~a" (request-params)))
;;     (format #t "~a: ~a\n" status body)
;;     (and (string=? status "200") body)))

;; (define (mp3tunes-restore-from-trash file_key)
;;   (define (request-params)
;;     (define ht (make-hash-table))
;;     (hash-table-put! ht 'output "xml")
;;     (hash-table-put! ht 'sid login-sxml-session-id)
;;     (hash-table-put! ht 'action "restore")
;;     (string-join (hash-table-map ht (lambda (key val) 
;; 				      (string-append (symbol->string key) "=" val)))
;; 		 "&"))
;;   (receive (status header body)
;;       (http-get "content.mp3tunes.com"
;; 		(format "/storage/lockerDelete/~a?~a" (request-params)))
;;     (format #t "~a: ~a\n" status body)
;;     (and (string=? status "200") body)))
